home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / w3 / w3-prefs.el.z / w3-prefs.el
Encoding:
Text File  |  1998-05-21  |  23.5 KB  |  646 lines
  1. ;;; w3-prefs.el --- Preferences panels for Emacs-W3
  2. ;; Author: wmperry
  3. ;; Created: 1997/10/17 14:08:19
  4. ;; Version: 1.26
  5. ;; Keywords: hypermedia, preferences
  6.  
  7. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  8. ;;; Copyright (c) 1996 by William M. Perry <wmperry@cs.indiana.edu>
  9. ;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc.
  10. ;;;
  11. ;;; This file is part of GNU Emacs.
  12. ;;;
  13. ;;; GNU Emacs is free software; you can redistribute it and/or modify
  14. ;;; it under the terms of the GNU General Public License as published by
  15. ;;; the Free Software Foundation; either version 2, or (at your option)
  16. ;;; any later version.
  17. ;;;
  18. ;;; GNU Emacs is distributed in the hope that it will be useful,
  19. ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21. ;;; GNU General Public License for more details.
  22. ;;;
  23. ;;; You should have received a copy of the GNU General Public License
  24. ;;; along with GNU Emacs; see the file COPYING.  If not, write to the
  25. ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  26. ;;; Boston, MA 02111-1307, USA.
  27. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  28.  
  29. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  30. ;;; Preferences panels for Emacs-W3
  31. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  32. (require 'w3-vars)
  33. (require 'w3-keyword)
  34. (require 'w3-toolbar)
  35. (eval-and-compile
  36.   (require 'w3-widget))
  37.  
  38. (defvar w3-preferences-panel-begin-marker nil)
  39. (defvar w3-preferences-panel-end-marker nil)
  40. (defvar w3-preferences-panels '(
  41.                 (appearance    . "Appearance")
  42.                 (images        . "Images")
  43.                 (cookies       . "HTTP Cookies")
  44.                 (hooks         . "Various Hooks")
  45.                 (compatibility . "Compatibility")
  46.                 (proxy         . "Proxy")
  47.                 (privacy       . "Privacy")))
  48.  
  49. (defun w3-preferences-generic-variable-callback (widget &rest ignore)
  50.   (condition-case ()
  51.       (set (widget-get widget 'variable) (widget-value widget))
  52.     (error (message "Invalid or incomplete data..."))))
  53.  
  54. (defun w3-preferences-restore-variables (vars)
  55.   (let ((temp nil))
  56.     (while vars
  57.       (setq temp (intern (format "w3-preferences-temp-%s" (car vars))))
  58.       (set (car vars) (symbol-value temp))
  59.       (if (fboundp 'custom-set-variables)
  60.       (eval (` (custom-set-variables '((, (car vars)) (quote (, (symbol-value temp))) t)))))
  61.       (setq vars (cdr vars)))))
  62.                      
  63. (defun w3-preferences-create-temp-variables (vars)
  64.   (let ((temp nil))
  65.     (while vars
  66.       (setq temp (intern (format "w3-preferences-temp-%s" (car vars))))
  67.       (set (make-local-variable temp) (symbol-value (car vars)))
  68.       (setq vars (cdr vars)))))
  69.   
  70.  
  71. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  72. ;;; Appearance of the frame / pages
  73. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  74. (defun w3-preferences-init-appearance-panel ()
  75.   (let ((vars '(w3-toolbar-orientation
  76.         w3-use-menus
  77.         w3-honor-stylesheets
  78.         w3-default-stylesheet
  79.         w3-default-homepage
  80.         w3-toolbar-type))
  81.     (temp nil))
  82.     (set (make-local-variable 'w3-preferences-temp-use-home-page)
  83.      (and w3-default-homepage t))
  84.     (w3-preferences-create-temp-variables vars)))
  85.  
  86. (defun w3-preferences-create-appearance-panel ()
  87.   ;; First the toolbars
  88.   (widget-insert "\nToolbars\n--------\n")
  89.   (widget-insert "\tShow Toolbars as:\t")
  90.   (widget-put
  91.    (widget-create 'radio
  92.           :value (symbol-value 'w3-preferences-temp-w3-toolbar-type)
  93.           :notify 'w3-preferences-generic-variable-callback
  94.           :format "%v"
  95.           (list 'item :format "%t\t" :tag "Pictures" :value 'pictures)
  96.           (list 'item :format "%t\t" :tag "Text"     :value 'text)
  97.           (list 'item :format "%t" :tag "Both" :value 'both))
  98.    'variable 'w3-preferences-temp-w3-toolbar-type)
  99.   (widget-insert "\n\tToolbars appear on ")
  100.   (widget-put
  101.    (widget-create 'choice
  102.           :value (symbol-value 'w3-preferences-temp-w3-toolbar-orientation)
  103.           :notify 'w3-preferences-generic-variable-callback
  104.           :format "%v"
  105.           :tag "Toolbar Position"
  106.           (list 'choice-item :format "%[%t%]" :tag "XEmacs Default" :value 'default)
  107.           (list 'choice-item :format "%[%t%]" :tag "Top" :value 'top)
  108.           (list 'choice-item :format "%[%t%]" :tag "Bottom" :value 'bottom)
  109.           (list 'choice-item :format "%[%t%]" :tag "Right" :value 'right)
  110.           (list 'choice-item :format "%[%t%]" :tag "Left" :value 'left)
  111.           (list 'choice-item :format "%[%t%]" :tag "No Toolbar" :value 'none))
  112.    'variable 'w3-preferences-temp-w3-toolbar-orientation)
  113.   (widget-insert " side of window.\n")
  114.  
  115.   ;; Home page
  116.   (widget-insert "\nStartup\n--------\n\tBrowser starts with:\t")
  117.   (widget-put
  118.    (widget-create
  119.     'radio
  120.     :format "%v"
  121.     :value (symbol-value 'w3-preferences-temp-use-home-page)
  122.     :notify 'w3-preferences-generic-variable-callback
  123.     (list 'item :format "%t\t" :tag "Blank Page" :value nil)
  124.     (list 'item :format "%t" :tag "Home Page Location" :value t))
  125.    'variable 'w3-preferences-temp-use-home-page)
  126.   (widget-insert "\n\t\tURL: ")
  127.   (widget-put
  128.    (widget-create
  129.     'editable-field
  130.     :value (or (symbol-value 'w3-preferences-temp-w3-default-homepage) "None")
  131.     :notify 'w3-preferences-generic-variable-callback)
  132.    'variable 'w3-preferences-temp-w3-default-homepage)
  133.  
  134.   ;; Stylesheet
  135.   (widget-insert "\nStyle\n--------\n\tDefault stylesheet:\t")
  136.   (widget-put
  137.    (widget-create
  138.     'file
  139.     :value (or (symbol-value 'w3-preferences-temp-w3-default-stylesheet) "")
  140.     :must-match t
  141.     :notify 'w3-preferences-generic-variable-callback)
  142.    'variable 'w3-preferences-temp-w3-default-stylesheet)
  143.   (widget-setup)
  144.   )
  145.  
  146. (defun w3-preferences-save-appearance-panel ()
  147.   (let ((vars '(w3-toolbar-orientation
  148.         w3-use-menus
  149.         w3-honor-stylesheets
  150.         w3-default-stylesheet
  151.         w3-toolbar-type))
  152.     (temp nil))
  153.   (if (symbol-value 'w3-preferences-temp-use-home-page)
  154.       (setq vars (cons 'w3-default-homepage vars))
  155.     (setq w3-default-homepage nil))
  156.   (w3-preferences-restore-variables vars)
  157.   (w3-toolbar-make-buttons)))
  158.  
  159.  
  160. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  161. ;;; The images panel
  162. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  163. (defun w3-preferences-init-images-panel ()
  164.   (let ((vars '(w3-delay-image-loads
  165.         w3-image-mappings)))
  166.     (w3-preferences-create-temp-variables vars)))
  167.  
  168. (defun w3-preferences-create-images-panel ()
  169.   (widget-insert "\n")
  170.   (widget-put
  171.    (widget-create
  172.     'checkbox
  173.     :notify 'w3-preferences-generic-variable-callback
  174.     :value (symbol-value 'w3-preferences-temp-w3-delay-image-loads))
  175.    'variable 'w3-preferences-temp-w3-delay-image-loads)
  176.   (widget-insert " Delay Image Loads\n"
  177.   ))
  178.  
  179. (defun w3-preferences-save-images-panel ()
  180.   (let ((vars '(w3-delay-image-loads
  181.         w3-image-mappings)))
  182.     (w3-preferences-restore-variables vars)))
  183.  
  184. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  185. ;;; The cookies panel
  186. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  187. (defun w3-preferences-init-cookies-panel ()
  188.   (let ((cookies url-cookie-storage)
  189.     (secure-cookies url-cookie-secure-storage))
  190.     )
  191.   )
  192.  
  193. (defun w3-preferences-create-cookies-panel ()
  194.   (widget-insert "\n\t\tSorry, not yet implemented.\n\n"))
  195.  
  196. (defun w3-preferences-save-cookies-panel ()
  197.   )
  198.  
  199.  
  200. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  201. ;;; The hooks panel
  202. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  203. (defvar w3-preferences-hooks-variables
  204.   '(w3-load-hook
  205.     w3-mode-hook
  206.     w3-preferences-cancel-hook
  207.     w3-preferences-default-hook
  208.     w3-preferences-ok-hook
  209.     w3-preferences-setup-hook
  210.     w3-source-file-hook))
  211.         
  212. (defun w3-preferences-init-hooks-panel ()
  213.   (w3-preferences-create-temp-variables w3-preferences-hooks-variables))
  214.  
  215. (defun w3-preferences-create-hooks-panel ()
  216.   (let ((todo w3-preferences-hooks-variables)
  217.     (cur nil)
  218.     (pt nil)
  219.     (doc nil))
  220.     (widget-insert "\n")
  221.     (while todo
  222.       (setq cur (car todo)
  223.         todo (cdr todo)
  224.         doc (documentation-property cur 'variable-documentation))
  225.       (if (string-match "^\\*" doc)
  226.       (setq doc (substring doc 1 nil)))
  227.       (setq pt (point))
  228.       (widget-insert "\n" (symbol-name cur) " - " doc)
  229.       (fill-region-as-paragraph pt (point))
  230.       (setq cur (intern (format "w3-preferences-temp-%s" cur)))
  231.       (widget-put
  232.        (widget-create
  233.     'sexp
  234.     :notify 'w3-preferences-generic-variable-callback
  235.     :value (or (symbol-value cur) "nil"))
  236.        'variable cur))
  237.     (widget-setup)))
  238.  
  239. (defun w3-preferences-save-hooks-panel ()
  240.   (w3-preferences-restore-variables w3-preferences-hooks-variables))
  241.  
  242.  
  243. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  244. ;;; The compatibility panel
  245. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  246. (defvar w3-preferences-compatibility-variables
  247.   '(
  248.     (w3-netscape-compatible-comments
  249.      . "Allow Netscape compatible comments")
  250.     (w3-user-colors-take-precedence
  251.      . "Ignore netscape document color control")
  252.     (url-honor-refresh-requests
  253.      . "Allow Netscape `Client Pull'"))
  254.   "A list of variables that the preferences compability pane knows about.")
  255.  
  256. (defun w3-preferences-init-compatibility-panel ()
  257.   (let ((compat w3-preferences-compatibility-variables)
  258.     (cur nil)
  259.     (var nil))
  260.     (w3-preferences-create-temp-variables
  261.      (mapcar 'car w3-preferences-compatibility-variables))))
  262.  
  263. (defun w3-preferences-create-compatibility-panel ()
  264.   (let ((compat w3-preferences-compatibility-variables)
  265.     (cur nil)
  266.     (var nil))
  267.     (widget-insert "\n")
  268.     (while compat
  269.       (setq cur (car compat)
  270.         compat (cdr compat)
  271.         var (intern (format "w3-preferences-temp-%s" (car cur))))
  272.       (widget-put
  273.        (widget-create 'checkbox
  274.               :notify 'w3-preferences-generic-variable-callback
  275.               :value (symbol-value var))
  276.        'variable var)
  277.       (widget-insert " " (cdr cur) "\n\n"))
  278.     (widget-setup)))
  279.  
  280. (defun w3-preferences-save-compatibility-panel ()
  281.   (w3-preferences-restore-variables
  282.    (mapcar 'car w3-preferences-compatibility-variables)))
  283.  
  284.  
  285. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  286. ;;; The proxy configuration panel
  287. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  288. (defun w3-preferences-init-proxy-panel ()
  289.   (let ((proxies '("FTP" "Gopher" "HTTP" "Security" "WAIS" "SHTTP" "News"))
  290.     (proxy nil)
  291.     (host-var nil)
  292.     (port-var nil)
  293.     (host nil)
  294.     (port nil)
  295.     (proxy-entry nil))
  296.     (widget-insert "\n")
  297.     (while proxies
  298.       (setq proxy (car proxies)
  299.         proxies (cdr proxies)
  300.         host-var (intern (format "w3-%s-proxy-host" (downcase proxy)))
  301.         port-var (intern (format "w3-%s-proxy-port" (downcase proxy)))
  302.         proxy-entry (cdr-safe (assoc (downcase proxy) url-proxy-services)))
  303.       (if (and proxy-entry (string-match "\\(.*\\):\\([0-9]+\\)" proxy-entry))
  304.       (setq host (match-string 1 proxy-entry)
  305.         port (match-string 2 proxy-entry))
  306.     (setq host proxy-entry
  307.           port nil))
  308.       (set (make-local-variable host-var) (or host ""))
  309.       (set (make-local-variable port-var) (or port ""))))
  310.   (set (make-local-variable 'w3-preferences-temp-no-proxy)
  311.        (cdr-safe (assoc "no_proxy" url-proxy-services))))
  312.  
  313. (defun w3-preferences-create-proxy-panel ()
  314.   (let ((proxies '("FTP" "Gopher" "HTTP" "Security" "WAIS" "SHTTP" "News"))
  315.     (proxy nil)
  316.     (host-var nil)
  317.     (port-var nil)
  318.     (urlobj nil))
  319.     (widget-insert "\n")
  320.     (while proxies
  321.       (setq proxy (car proxies)
  322.         proxies (cdr proxies)
  323.         host-var (intern (format "w3-%s-proxy-host" (downcase proxy)))
  324.         port-var (intern (format "w3-%s-proxy-port" (downcase proxy))))
  325.       (widget-insert (format "%10s Proxy: " proxy))
  326.       (widget-put
  327.        (widget-create 'editable-field
  328.               :size 20
  329.               :value-face 'underline
  330.               :notify 'w3-preferences-generic-variable-callback
  331.               :value (format "%-20s" (symbol-value host-var)))
  332.        'variable host-var)
  333.       (widget-insert "  Port: ")
  334.       (widget-put
  335.        (widget-create 'editable-field
  336.               :size 5
  337.               :value-face 'underline
  338.               :notify 'w3-preferences-generic-variable-callback
  339.               :value (format "%5s" (symbol-value port-var)))
  340.        'variable port-var)
  341.       (widget-insert "\n\n"))
  342.     (widget-insert "        No proxy: ")
  343.     (widget-put
  344.      (widget-create 'editable-field
  345.             :size 40
  346.             :value-face 'underline
  347.             :notify 'w3-preferences-generic-variable-callback
  348.             :value (or (symbol-value 'w3-preferences-temp-no-proxy) ""))
  349.      'variable 'w3-preferences-temp-no-proxy)
  350.     (widget-setup)))
  351.  
  352. (defun w3-preferences-save-proxy-panel ()
  353.   (let ((proxies '("FTP" "Gopher" "HTTP" "Security" "WAIS" "SHTTP" "News"))
  354.     (proxy nil)
  355.     (host-var nil)
  356.     (port-var nil)
  357.     (urlobj nil)
  358.     (host nil)
  359.     (port nil)
  360.     (new-proxy-services nil))
  361.     (if (/= 0 (length (symbol-value 'w3-preferences-temp-no-proxy)))
  362.     (setq new-proxy-services (cons
  363.                   (cons
  364.                    "no_proxy"
  365.                    (symbol-value 'w3-preferences-temp-no-proxy))
  366.                   new-proxy-services)))
  367.     (while proxies
  368.       (setq proxy (car proxies)
  369.         proxies (cdr proxies)
  370.         host-var (intern (format "w3-%s-proxy-host" (downcase proxy)))
  371.         port-var (intern (format "w3-%s-proxy-port" (downcase proxy)))
  372.         urlobj (url-generic-parse-url
  373.             (cdr-safe
  374.              (assoc (downcase proxy) url-proxy-services)))
  375.         host (symbol-value host-var)
  376.         port (symbol-value port-var))
  377.       (if (and host (/= 0 (length host)))
  378.       (setq new-proxy-services (cons (cons (downcase proxy)
  379.                            (format "%s:%s" host
  380.                                (or port "80")))
  381.                      new-proxy-services))))
  382.     (setq url-proxy-services new-proxy-services)))
  383.  
  384. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  385. ;;; Privacy panel
  386. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  387.  
  388. (defsubst w3-preferences-privacy-bits-sort (bits) 
  389.   (sort bits (function (lambda (a b)
  390.              (memq b (memq a '(email os lastloc agent cookie)))))))
  391.  
  392. (defvar url-valid-privacy-levels
  393.   '((paranoid . (email os lastloc agent cookie))
  394.     (high     . (email lastloc))
  395.     (low      . (lastloc))
  396.     (none     . nil)))
  397.  
  398. (defvar w3-preferences-privacy-bit-widgets nil)
  399. (defvar w3-preferences-privacy-level-widget nil)
  400. (defvar w3-preferences-temp-url-privacy-level nil)
  401. ;; darnit i just noticed the checklist widget, this should probably be
  402. ;; reimplemented with that instead of checkboxes, but i've almost finished.
  403. (defun w3-preferences-privacy-bit-callback (widget &rest ignore)
  404.   (let ((privacy-bits (if (listp w3-preferences-temp-url-privacy-level)
  405.                 w3-preferences-temp-url-privacy-level
  406.               (copy-list (cdr-safe (assq w3-preferences-temp-url-privacy-level url-valid-privacy-levels)))))
  407.       (bit (widget-get widget 'bit))
  408.       (val (widget-value widget)))
  409.     (if val
  410.       (setq privacy-bits (delq bit privacy-bits))
  411.       (setq privacy-bits (w3-preferences-privacy-bits-sort (cons bit (delq bit privacy-bits)))))
  412.     (setq w3-preferences-temp-url-privacy-level
  413.         (or (car (rassoc privacy-bits url-valid-privacy-levels))
  414.             privacy-bits))
  415.     (widget-value-set w3-preferences-privacy-level-widget 
  416.                 (if (listp w3-preferences-temp-url-privacy-level)
  417.                 'custom
  418.               w3-preferences-temp-url-privacy-level))
  419.     ))
  420.  
  421.  
  422. (defun w3-preferences-privacy-level-callback (widget &rest ignore)
  423.   (let* ((val (widget-value widget))
  424.        (privacy-bits (cdr-safe (assq val url-valid-privacy-levels))))
  425.     (if (eq val 'custom) nil
  426.       (setq w3-preferences-temp-url-privacy-level val)
  427.       (mapcar (function (lambda (bit)
  428.                 (widget-value-set (cdr bit)
  429.                           (not (memq (car bit)
  430.                                  privacy-bits)))))
  431.             w3-preferences-privacy-bit-widgets))
  432.     ))
  433.  
  434. (defun w3-preferences-init-privacy-panel ()
  435.   (w3-preferences-create-temp-variables '(url-privacy-level
  436.                       url-cookie-confirmation))
  437.   (setq w3-preferences-privacy-bit-widgets nil)
  438.   (setq w3-preferences-privacy-level-widget nil))
  439.  
  440. (defsubst w3-preferences-create-privacy-bit-widget (bit bit-text current-bits)
  441.   (let ((bit-widget (widget-create 
  442.              'checkbox
  443.              :value (not (memq bit current-bits))
  444.              :notify 'w3-preferences-privacy-bit-callback
  445.              )))
  446.     (widget-put bit-widget 'bit bit)
  447.     (setq w3-preferences-privacy-bit-widgets (cons (cons bit bit-widget)
  448.                            w3-preferences-privacy-bit-widgets))
  449.     (widget-insert " " bit-text "\n")))
  450.  
  451.  
  452. (defun w3-preferences-create-privacy-panel ()
  453.   (let ((privacy-bits (if (listp url-privacy-level)
  454.               url-privacy-level
  455.             (cdr-safe (assq url-privacy-level url-valid-privacy-levels)))))
  456.     (widget-insert "\n")
  457.     (widget-insert "General Privacy Level: ")
  458.     ;;; XXX something is weird with case folding in the following widget if you
  459.     ;;; type an option in lower case it accepts it but doesn't do anything
  460.     (setq w3-preferences-privacy-level-widget
  461.       (widget-create 
  462.        'choice
  463.        :value (if (listp w3-preferences-temp-url-privacy-level)
  464.               'custom
  465.             w3-preferences-temp-url-privacy-level)
  466.         :notify 'w3-preferences-privacy-level-callback
  467.        :format "%v"
  468.        :tag "Privacy Level"
  469.        (list 'choice-item :format "%[%t%]" :tag "Paranoid" :value 'paranoid)
  470.        (list 'choice-item :format "%[%t%]" :tag "High"     :value 'high)
  471.        (list 'choice-item :format "%[%t%]" :tag "Low"      :value 'low)
  472.        (list 'choice-item :format "%[%t%]" :tag "None"     :value 'none)
  473.        (list 'choice-item :format "%[%t%]" :tag "Custom"   :value 'custom)))
  474.     (widget-put w3-preferences-privacy-level-widget 'variable 'w3-preferences-temp-url-privacy-level)
  475.     
  476.     (widget-insert "\n(controls the options below)\n\nSend the following information with each request:\n")
  477.     (setq w3-preferences-privacy-bit-widgets nil)
  478.     (w3-preferences-create-privacy-bit-widget 'email   "E-mail address" privacy-bits)
  479.     (w3-preferences-create-privacy-bit-widget 'lastloc "Last location visited" privacy-bits)
  480.     (w3-preferences-create-privacy-bit-widget 'os      "Operating system information" privacy-bits)
  481.     (w3-preferences-create-privacy-bit-widget 'agent   "User agent information" privacy-bits)
  482.     (w3-preferences-create-privacy-bit-widget 'cookie  "Accept cookies" privacy-bits)
  483.     (widget-insert "    ")
  484.     (widget-put
  485.      (widget-create 
  486.       'checkbox
  487.       :value (symbol-value 'w3-preferences-temp-url-cookie-confirmation)
  488.       :notify 'w3-preferences-generic-variable-callback)
  489.      'variable 'w3-preferences-temp-url-cookie-confirmation)
  490.     (widget-insert " Ask before accepting cookies\n"))
  491.   (widget-setup))
  492.   
  493. (defun w3-preferences-save-privacy-panel ()
  494.   (w3-preferences-restore-variables '(url-privacy-level
  495.                       url-cookie-confirmation))
  496.   (url-setup-privacy-info))
  497.  
  498. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  499. ;;;
  500. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  501. (defun w3-preferences-create-panel (panel)
  502.   (let ((func (intern (format "w3-preferences-create-%s-panel" panel)))
  503.     (inhibit-read-only t))
  504.     (goto-char w3-preferences-panel-begin-marker)
  505.     (delete-region w3-preferences-panel-begin-marker
  506.            w3-preferences-panel-end-marker)
  507.     (set-marker-insertion-type w3-preferences-panel-end-marker t)
  508.     (if (fboundp func)
  509.     (funcall func)
  510.       (insert (format "You should be seeing %s right now.\n" panel))))
  511.   (set-marker-insertion-type w3-preferences-panel-end-marker nil)
  512.   (set-marker w3-preferences-panel-end-marker (point))
  513.   (goto-char w3-preferences-panel-begin-marker)
  514.   (condition-case ()
  515.       (widget-forward 1)
  516.     (error nil)))
  517.  
  518. (defun w3-preferences-notify (widget widget-ignore &optional event)
  519.   (let* ((glyph (and event w3-running-xemacs (event-glyph event)))
  520.      (x     (and glyph (widget-glyphp glyph) (event-glyph-x-pixel event)))
  521.      (y     (and glyph (widget-glyphp glyph) (event-glyph-y-pixel event)))
  522.      (map   (widget-get widget 'usemap))
  523.      (value (widget-value widget)))
  524.     (if (and map x y)
  525.     (setq value (w3-point-in-map (vector x y) map)))
  526.     (if value
  527.     (w3-preferences-create-panel value))))
  528.  
  529. (defun w3-preferences-save-options ()
  530.   (w3-menu-save-options))
  531.  
  532. (defun w3-preferences-ok-callback (widget &rest ignore)
  533.   (let ((panels w3-preferences-panels)
  534.     (buffer (current-buffer))
  535.     (func nil))
  536.     (run-hooks 'w3-preferences-ok-hook)
  537.     (while panels
  538.       (setq func (intern
  539.           (format "w3-preferences-save-%s-panel" (caar panels)))
  540.         panels (cdr panels))
  541.       (if (fboundp func)
  542.       (funcall func)))
  543.     (if (fboundp 'custom-save-variables)
  544.     (custom-save-variables))
  545.     (w3-preferences-save-options)
  546.     (message "Options saved")
  547.     (sit-for 1)
  548.     (kill-buffer (current-buffer))))
  549.  
  550. (defun w3-preferences-reset-all-panels ()
  551.   (let ((panels w3-preferences-panels)
  552.     (func nil))
  553.     (while panels
  554.       (setq func (intern (format "w3-preferences-init-%s-panel"
  555.                  (caar panels)))
  556.         panels (cdr panels))
  557.       (if (and func (fboundp func))
  558.       (funcall func)))))
  559.  
  560. (defun w3-preferences-cancel-callback (widget &rest ignore)
  561.   (if (not (funcall url-confirmation-func "Cancel and lose all changes? "))
  562.       (error "Not cancelled!"))
  563.   (w3-preferences-reset-all-panels)
  564.   (kill-buffer (current-buffer))
  565.   (run-hooks 'w3-preferences-cancel-hook))
  566.  
  567. (defun w3-preferences-reset-callback (widget &rest ignore)
  568.   (w3-preferences-reset-all-panels)
  569.   (run-hooks 'w3-preferences-default-hook)
  570.   (w3-preferences-create-panel (caar w3-preferences-panels)))
  571.  
  572. (defvar w3-preferences-setup-hook nil
  573.   "*Hooks to be run before setting up the preferences buffer.")
  574.  
  575. (defvar w3-preferences-cancel-hook nil
  576.   "*Hooks to be run when cancelling the preferences (Cancel was chosen).")
  577.  
  578. (defvar w3-preferences-default-hook nil
  579.   "*Hooks to be run when resetting preference defaults (Defaults was chosen).")
  580.  
  581. (defvar w3-preferences-ok-hook nil
  582.   "*Hooks to be run before saving the preferences (OK was chosen).")
  583.  
  584. (defun w3-preferences-init-all-panels ()
  585.   (let ((todo w3-preferences-panels)
  586.     (func nil))
  587.     (while todo
  588.       (setq func (intern (format "w3-preferences-init-%s-panel" (caar todo)))
  589.         todo (cdr todo))
  590.       (and (fboundp func) (funcall func)))))
  591.  
  592. ;;;###autoload
  593. (defun w3-preferences-edit ()
  594.   (interactive)
  595.   (let* ((prefs-buffer (get-buffer-create "W3 Preferences"))
  596.      (widget nil)
  597.      (inhibit-read-only t)
  598.      (window-conf (current-window-configuration)))
  599.     (delete-other-windows)
  600.     (set-buffer prefs-buffer)
  601.     (set (make-local-variable 'widget-push-button-gui) nil)
  602.     (w3-preferences-init-all-panels)
  603.     (set-window-buffer (selected-window) prefs-buffer)
  604.     (make-local-variable 'widget-field-face)
  605.     (setq w3-preferences-panel-begin-marker (make-marker)
  606.       w3-preferences-panel-end-marker (make-marker))
  607.     (set-marker-insertion-type w3-preferences-panel-begin-marker nil)
  608.     (set-marker-insertion-type w3-preferences-panel-end-marker t)
  609.     (use-local-map widget-keymap)
  610.     (erase-buffer)
  611.     (run-hooks 'w3-preferences-setup-hook)
  612.     (setq widget (apply 'widget-create 'menu-choice
  613.             :tag "Panel"
  614.             :notify 'w3-preferences-notify
  615.             :value 'appearance
  616.             (mapcar
  617.              (function
  618.               (lambda (x)
  619.                 (list 'choice-item
  620.                   :format "%[%t%]"
  621.                   :tag (cdr x)
  622.                   :value (car x))))
  623.              w3-preferences-panels)))
  624.     (goto-char (point-max))
  625.     (insert "\n\n")
  626.     (set-marker w3-preferences-panel-begin-marker (point))
  627.     (set-marker w3-preferences-panel-end-marker (point))
  628.     (w3-preferences-create-panel (caar w3-preferences-panels))
  629.     (goto-char (point-max))
  630.     (widget-insert "\n\n")
  631.     (widget-create 'push-button
  632.            :notify 'w3-preferences-ok-callback
  633.            :value "Ok")
  634.     (widget-insert "  ")
  635.     (widget-create 'push-button
  636.            :notify 'w3-preferences-cancel-callback
  637.            :value "Cancel")
  638.     (widget-insert "  ")
  639.     (widget-create 'push-button
  640.            :notify 'w3-preferences-reset-callback
  641.            :value "Reset")
  642.     (center-region (point-min) w3-preferences-panel-begin-marker)
  643.     (center-region w3-preferences-panel-end-marker (point-max))))
  644.  
  645. (provide 'w3-prefs)
  646.